home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH3 / SRC / RELATIVE.FRM < prev    next >
Text File  |  1996-02-03  |  4KB  |  138 lines
  1. VERSION 4.00
  2. Begin VB.Form RelativeForm 
  3.    AutoRedraw      =   -1  'True
  4.    Caption         =   "Relative"
  5.    ClientHeight    =   2985
  6.    ClientLeft      =   1950
  7.    ClientTop       =   1905
  8.    ClientWidth     =   4860
  9.    Height          =   3675
  10.    Left            =   1890
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   199
  13.    ScaleMode       =   3  'Pixel
  14.    ScaleWidth      =   324
  15.    Top             =   1275
  16.    Width           =   4980
  17.    Begin VB.PictureBox RelativePict 
  18.       AutoRedraw      =   -1  'True
  19.       Height          =   2700
  20.       Left            =   2445
  21.       ScaleHeight     =   2640
  22.       ScaleWidth      =   2340
  23.       TabIndex        =   1
  24.       Top             =   0
  25.       Width           =   2400
  26.    End
  27.    Begin VB.PictureBox RGBPict 
  28.       AutoRedraw      =   -1  'True
  29.       Height          =   2700
  30.       Left            =   0
  31.       ScaleHeight     =   2640
  32.       ScaleWidth      =   2340
  33.       TabIndex        =   0
  34.       Top             =   0
  35.       Width           =   2400
  36.    End
  37.    Begin VB.Label Label1 
  38.       Alignment       =   2  'Center
  39.       Caption         =   "Palette Relative RGB"
  40.       Height          =   255
  41.       Index           =   1
  42.       Left            =   2445
  43.       TabIndex        =   3
  44.       Top             =   2760
  45.       Width           =   2400
  46.    End
  47.    Begin VB.Label Label1 
  48.       Alignment       =   2  'Center
  49.       Caption         =   "RGB"
  50.       Height          =   255
  51.       Index           =   0
  52.       Left            =   0
  53.       TabIndex        =   2
  54.       Top             =   2760
  55.       Width           =   2400
  56.    End
  57.    Begin VB.Menu mnuFile 
  58.       Caption         =   "&File"
  59.       Begin VB.Menu mnuFileExit 
  60.          Caption         =   "E&xit"
  61.       End
  62.    End
  63. End
  64. Attribute VB_Name = "RelativeForm"
  65. Attribute VB_Creatable = False
  66. Attribute VB_Exposed = False
  67. Option Explicit
  68.  
  69. ' ***********************************************
  70. ' Fill picture boxes with shades of color.
  71. ' ***********************************************
  72. Sub FillPictures()
  73. Const NUM_COLS = 16
  74. Const ROWS_PER_COLOR = 4
  75. Const NUM_ROWS = ROWS_PER_COLOR * 3
  76. Const NUM_BOXES = ROWS_PER_COLOR * NUM_COLS
  77.  
  78. Dim dx As Single
  79. Dim dy As Single
  80. Dim x As Single
  81. Dim y As Single
  82. Dim clr As Integer
  83. Dim dr As Integer
  84. Dim dg As Integer
  85. Dim db As Integer
  86. Dim i As Integer
  87. Dim j As Integer
  88. Dim r As Integer
  89. Dim g As Integer
  90. Dim b As Integer
  91.  
  92.     dx = RGBPict.ScaleWidth / NUM_COLS
  93.     dy = RGBPict.ScaleHeight / NUM_ROWS
  94.     
  95.     For clr = 1 To 3
  96.         dr = 0
  97.         dg = 0
  98.         db = 0
  99.         Select Case clr
  100.             Case 1  ' Shades of red.
  101.                 dr = 255 / NUM_BOXES
  102.             Case 2  ' Shades of green.
  103.                 dg = 255 / NUM_BOXES
  104.             Case 3  ' Shades of blue.
  105.                 db = 255 / NUM_BOXES
  106.         End Select
  107.         
  108.         r = 0
  109.         g = 0
  110.         b = 0
  111.         For i = 1 To ROWS_PER_COLOR
  112.             x = 0
  113.             For j = 1 To NUM_COLS
  114.                 RGBPict.Line (x, y)-Step(dx, dy), _
  115.                     RGB(r, g, b), BF
  116.                 RelativePict.Line (x, y)-Step(dx, dy), _
  117.                     RGB(r, g, b) + &H2000000, BF
  118.                 r = r + dr
  119.                 g = g + dg
  120.                 b = b + db
  121.                 x = x + dx
  122.             Next j
  123.             y = y + dy
  124.         Next i
  125.     Next clr
  126. End Sub
  127.  
  128. Private Sub Form_Load()
  129.     FillPictures
  130. End Sub
  131.  
  132.  
  133.  
  134. Private Sub mnuFileExit_Click()
  135.     Unload Me
  136. End Sub
  137.  
  138.